######################################################################
# Time-stamp: <05/07/04 16:46:14 ostolop>
######################################################################
package EP::EPC::Core::Ordination;

use strict;

use EP::Config;
use EP::Common;
use EP::Common::General;
use EP::Common::Error ':try';

use EP::EPC::Core;
use EP::EPC::Core::Component;

use EP::Rclient;

use File::Basename;
use File::Temp;

our @ISA = qw ( EP::EPC::Core::Component );

sub process_component {
  my $self = shift;

  my ( $output, $images, $chime ) = $self->run_ordination ();

  my %process_result = ( %$output, %$images );
  $process_result{chime} = { type => "chime", value => $chime, label => "Visualization" };
  $process_result{src_dataset_id} = $self->{src_dataset}->id;
  $process_result{dst_dataset_id} = $self->{src_dataset}->id;

  $self->{CD}->{process_result} = \%process_result;
  return $self->record_analysis_history ();
}

sub nan_impute_row_avg {
  my ($bin_file) = @_;
  my $nanimp_bin_file = $bin_file . ".nanimp";

  return $nanimp_bin_file if -s $nanimp_bin_file;

  EP::Rclient->R(<<__RCODE__);
app_root = "$EP::Config::h->{ROOT}";
source("$EP::Config::h->{ROOT}/cgi-lib/R/ep.io.R");
source("$EP::Config::h->{ROOT}/cgi-lib/R/ep.impute_data.R");

M = ep.readBin("$bin_file");
O = ep.nanimprowavg(M);
ep.writeBin( O, "$nanimp_bin_file" );
__RCODE__

  die "R did not generate imputed data!" if not -e $nanimp_bin_file;
  return $nanimp_bin_file;
}

sub run_ordination {
  my $self = shift;

  throw EP::Common::Error ( -value => AFFY_TRANSFORM_RAW_DATA ) if $self->{src_dataset}->type eq "affy";

  my $dataset_folder_path = $EP::Config::h->{EPNG_USRDATA_PATH} . "/" . $self->{src_dataset}->folder->location;

  my $bin_file = $dataset_folder_path . "/" . $self->{src_dataset}->filename . ".bin";
  $bin_file = nan_impute_row_avg ( $bin_file ) if $self->{query}->param ( "impute_row_avg" );

  my $rand = "$$" . rand(100);

  my $tmpl_values = { html_root    => $EP::Config::h->{HTML_ROOT},
          src          => $bin_file,
          srcrowannot  => $dataset_folder_path . "/" . $self->{src_dataset}->filename . ".rows",
          srccolannot  => $dataset_folder_path . "/" . $self->{src_dataset}->filename . ".columns",
          filename     => $self->{src_dataset}->filename . "." . $rand,
          outputdir    => $dataset_folder_path,
          nf           => $self->{query}->param ( "nf" ),
          ord_type     => $self->{query}->param ( "ord_type" ),
          outputlist   => $self->{query}->param ( "output_files" ).$self->{query}->param ( "output_graphs" ) };

  EP::Rclient->R(<<__RCODE__);
app_root = "$EP::Config::h->{ROOT}";
source("$EP::Config::h->{ROOT}/cgi-lib/tmpl/R/ep.run_ord.tmpl.R");
ep.run_ord( "$tmpl_values->{src}"
          , "$tmpl_values->{srcrowannot}"
          , "$tmpl_values->{srccolannot}"
          , "$tmpl_values->{filename}"
          , "$tmpl_values->{outputdir}"
          , $tmpl_values->{nf}
          , "$tmpl_values->{ord_type}"
          , "$tmpl_values->{outputlist}"
          );
__RCODE__

  my $output_www_base = "$EP::Config::h->{EPNG_USRDATA_URL}/" . $self->{src_dataset}->folder->location . "/" . $self->{src_dataset}->filename  . "." . $rand;
  my $output_path_base = "$EP::Config::h->{EPNG_USRDATA_PATH}/" . $self->{src_dataset}->folder->location . "/" . $self->{src_dataset}->filename . "." . $rand ;

  my $output = get_run_ord_output ( $tmpl_values->{outputlist}, $output_www_base, $tmpl_values->{ord_type}, $output_path_base, $self->{query}->param ( "nf" ) );
  my $images = get_run_ord_images ( $tmpl_values->{outputlist}, $output_www_base, $tmpl_values->{ord_type}, $output_path_base );
  my $chime  = display_chime ($output_path_base);

  return ( $output, $images, $chime );
}

sub parse_template {
  my ($tmpl_values, $src, $dst) = @_;
  local(*FILE);

  my $template = Text::Template->new(TYPE => "FILE", SOURCE => $src );
  my $text = $template->fill_in( HASH => $tmpl_values );

  open (FILE, ">$dst");
  print FILE $text;
  close FILE;

  return 1;
}

sub get_run_ord_images {
  my $outlist          = shift;
  my $output_www_base  = shift;
  my $ord_type         = shift;

  my %images;

  if ($outlist =~ /V/ ) {
    $images{eig_graph} = { type => "image/png",
         value => $output_www_base."_eig.png",
         label => "Graph of Eigenvalues"
       };
  }

  if ($outlist =~ /A/ ) {
    $images{array_graph} = { type  => "image/png",
           value => $output_www_base."_array.png",
           label  => "Graph of Genes"
         };
  }

  if ($outlist =~ /G/ ) {
    $images{gene_graph} = { type  => "image/png",
          value => $output_www_base."_genes.png",
          label  => "Graph of Arrays"
        };
  }

  if ($outlist =~ /B/ ) {
    if ($ord_type =~ /COA/) {
      $images{biplot_graph} = { type  => "image/png",
        value => $output_www_base."_biplot.png",
        label  => "Biplot of Genes and Arrays"
            };
    }
  }

  return \%images;
}

sub get_run_ord_output {
  my $outlist         = shift;
  my $output_www_base = shift;
  my $ord_type        = shift;
  my $output_path_base = shift;
  my $nf = shift;

  my %output;

  $output{logfile} = { type  => "text/plain",
           value => $output_www_base."_log.txt",
           label => "Summary of analysis" };

  if ($outlist =~ /E/ ) {
    $output{eigvals} = { type => "text/plain",
       value => $output_www_base."_eig.txt",
       label => "Eigenvalues" };
  }

  if ( $outlist =~ /R/ ) {
    open P, $output_path_base."_li.txt";
    open PX, ">$output_path_base"."_li.xml";
    print PX '<?xml version="1.0"?>';
    print PX '<table>';
    print PX '<head>';
    print PX '<data>Name</data>';
    print PX "<data>Axis $_</data>" foreach 1 .. $nf;
    print PX '</head>';
    while (<P>) {
      chomp;
      my @d = split /\t/;
      print PX '<row>';
      print PX "<data>$_</data>" foreach @d;
      print PX '</row>';
    }
    print PX '</table>';
    close P;
    close PX;
    $output{rows} = {  type  => "xml/table",
           value => $output_www_base."_li.xml",
           label => "Coordinates of rows" };
  }

  if ( $outlist =~ /C/ ) {
    open P, $output_path_base."_co.txt";
    open PX, ">$output_path_base"."_co.xml";
    print PX '<?xml version="1.0"?>';
    print PX '<table>';
    print PX '<head>';
    print PX '<data>Name</data>';
    print PX "<data>Component $_</data>" foreach 1 .. $nf;
    print PX '</head>';
    while (<P>) {
      chomp;
      my @d = split /\t/;
      print PX '<row>';
      print PX "<data>$_</data>" foreach @d;
      print PX '</row>';
    }
    print PX '</table>';
    close P;
    close PX;
    $output{cols} = { type => "xml/table",
          value => $output_www_base."_co.xml",
          label => "Coordinates of columns" };
  }

  return \%output;
}

sub display_chime {
  my $output_path_base = shift;

  my $pdb_filename= $output_path_base. "_li.pdb" ;
  my ($pdbfile) = $pdb_filename =~ /.*\/(.*?)$/;
  `cp $pdb_filename $EP::Config::h->{TMP}/$pdbfile`;

  my $embedhtml = <<__EMBED__;
    <script src="$EP::Config::h->{HTML_HREF}/static/js/Jmol.js"></script>
    <script>jmolSetCodebase("$EP::Config::h->{HTML_HREF}/static/js");</script>

     <table cellpadding="0" border="0" width="90%">
     <tr><td>
    <script>
      jmolApplet(400, "$EP::Config::h->{HTML_HREF}/tmp/$pdbfile", "wireframe off; set axes on; select *; spacefill 0; select SAM*; spacefill 40; color red;  rotate x 10; rotate y 10; rotate z -10; color axes black;  background  white;set picking ON; set picking LABEL; set perspectivedepth off; set scale3d 1;" );
    </script>

       </td></tr>
       </table>
__EMBED__
  return $embedhtml;
}

1;
